vis_hw_2

Data reading

hogwarts <- read_csv("data/hogwarts_2024.csv")
hogwarts |> head()

## # A tibble: 6 × 60
##      id house    course sex   wandCore bloodStatus result Defence against the …¹
##   <dbl> <chr>     <dbl> <chr> <chr>    <chr>        <dbl>                  <dbl>
## 1     1 Ravencl…      4 fema… unicorn… half-blood      94                     73
## 2     2 Hufflep…      5 male  phoenix… half-blood      33                     38
## 3     3 Ravencl…      4 fema… dragon … half-blood     137                     52
## 4     4 Hufflep…      2 male  phoenix… half-blood      27                     50
## 5     5 Hufflep…      2 fema… phoenix… half-blood      67                     47
## 6     6 Gryffin…      6 male  phoenix… muggle-born    126                     44
## # ℹ abbreviated name: ¹​`Defence against the dark arts exam`
## # ℹ 52 more variables: `Flying exam` <dbl>, `Astronomy exam` <dbl>,
## #   `Herbology exam` <dbl>, `Divinations exam` <dbl>, `Charms exam` <dbl>,
## #   `History of magic exam` <dbl>, `Arithmancy exam` <dbl>,
## #   `Care of magical creatures exam` <dbl>, `Muggle studies exam` <dbl>,
## #   `Study of ancient runes exam` <dbl>, `Transfiguration exam` <dbl>,
## #   `Potions exam` <dbl>, week_1 <dbl>, week_2 <dbl>, week_3 <dbl>, …

Checking dataset structure

hogwarts |> glimpse()

## Rows: 560
## Columns: 60
## $ id                                   <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11…
## $ house                                <chr> "Ravenclaw", "Hufflepuff", "Raven…
## $ course                               <dbl> 4, 5, 4, 2, 2, 6, 7, 5, 2, 3, 7, …
## $ sex                                  <chr> "female", "male", "female", "male…
## $ wandCore                             <chr> "unicorn hair", "phoenix feather"…
## $ bloodStatus                          <chr> "half-blood", "half-blood", "half…
## $ result                               <dbl> 94, 33, 137, 27, 67, 126, 63, 7, …
## $ `Defence against the dark arts exam` <dbl> 73, 38, 52, 50, 47, 44, 51, 47, 2…
## $ `Flying exam`                        <dbl> 33, 36, 73, 42, 41, 52, 34, 34, 2…
## $ `Astronomy exam`                     <dbl> 57, 45, 66, 49, 57, 59, 58, 37, 5…
## $ `Herbology exam`                     <dbl> 73, 50, 62, 39, 38, 46, 59, 23, 2…
## $ `Divinations exam`                   <dbl> 66, 54, 72, 42, 47, 49, 42, 38, 1…
## $ `Charms exam`                        <dbl> 60, 70, 77, 46, 35, 55, 86, 20, 4…
## $ `History of magic exam`              <dbl> 52, 36, 60, 45, 50, 40, 55, 21, 2…
## $ `Arithmancy exam`                    <dbl> 61, 36, 58, 32, 76, 50, 41, 31, 2…
## $ `Care of magical creatures exam`     <dbl> 44, 41, 70, 36, 46, 73, 29, 36, 4…
## $ `Muggle studies exam`                <dbl> 64, 34, 52, 59, 50, 54, 36, 31, 4…
## $ `Study of ancient runes exam`        <dbl> 50, 35, 59, 39, 48, 56, 47, 41, 3…
## $ `Transfiguration exam`               <dbl> 74, 70, 70, 15, 32, 86, 100, 31, …
## $ `Potions exam`                       <dbl> 67, 38, 22, 64, 56, 60, 62, 55, 1…
## $ week_1                               <dbl> 0, -5, 0, -1, 1, 5, 1, -20, 3, -2…
## $ week_2                               <dbl> -10, 1, 0, 5, 20, 10, -5, 10, 1, …
## $ week_3                               <dbl> 0, -1, 1, -5, 10, -5, 3, -5, -3, …
## $ week_4                               <dbl> 10, 1, -1, 10, -10, 10, 0, -10, -…
## $ week_5                               <dbl> 3, -5, 3, 0, -1, 20, 5, 5, -3, 5,…
## $ week_6                               <dbl> -20, 20, 0, 0, 0, 0, 0, 5, 0, -1,…
## $ week_7                               <dbl> 10, 10, 1, -3, -20, 1, 10, 3, -5,…
## $ week_8                               <dbl> 5, 5, 1, -5, 5, 5, 0, 1, 0, 20, -…
## $ week_9                               <dbl> 1, 1, 3, -1, 0, 3, -20, -20, -10,…
## $ week_10                              <dbl> 20, -10, 1, 5, -1, 0, 5, -5, 5, 3…
## $ week_11                              <dbl> 5, -10, 20, 0, 0, 0, 5, 10, 5, 5,…
## $ week_12                              <dbl> 5, -5, 1, -20, -10, -5, 0, 5, 1, …
## $ week_13                              <dbl> -20, -5, 10, 0, 0, 1, -1, 10, -20…
## $ week_14                              <dbl> 0, 5, 3, 10, -10, 20, 0, -20, -20…
## $ week_15                              <dbl> 1, 20, 1, 0, -20, 10, 1, 3, -20, …
## $ week_16                              <dbl> 20, 5, 5, 5, 0, 3, 10, -1, 5, 5, …
## $ week_17                              <dbl> 3, 0, 10, 5, 5, -5, -1, 10, -10, …
## $ week_18                              <dbl> 10, 5, 5, 5, 10, -20, 0, 10, 3, 5…
## $ week_19                              <dbl> -10, 0, -5, -1, 0, -1, 0, 20, 0, …
## $ week_20                              <dbl> 10, -10, 5, 10, 0, -1, -1, 10, 0,…
## $ week_21                              <dbl> 0, 5, 5, 3, 5, 0, 0, -5, -5, 5, 5…
## $ week_22                              <dbl> 20, -5, 5, 0, 20, 5, -1, 0, 0, 20…
## $ week_23                              <dbl> 5, 1, -3, 20, -5, 20, 0, 1, 1, 5,…
## $ week_24                              <dbl> 10, -20, -20, 0, 10, 5, 5, -3, -5…
## $ week_25                              <dbl> 0, -20, 1, 3, 5, 1, -5, 0, -20, 2…
## $ week_26                              <dbl> 10, 10, 5, -1, 0, 5, 5, -3, 0, 20…
## $ week_27                              <dbl> 5, 5, -3, 0, 20, 5, 0, -5, 10, 3,…
## $ week_28                              <dbl> -3, 20, 20, 1, 10, 5, 1, 10, 0, 1…
## $ week_29                              <dbl> -20, -5, 5, 5, -10, 1, 0, -3, 0, …
## $ week_30                              <dbl> 5, 1, -5, 5, -5, -1, -20, 20, 1, …
## $ week_31                              <dbl> 5, 5, 20, -5, -10, -3, 0, -10, 20…
## $ week_32                              <dbl> -5, 1, 20, -1, -10, 5, 10, 1, 0, …
## $ week_33                              <dbl> 0, 10, 3, 3, 0, 0, -1, 0, -20, 3,…
## $ week_34                              <dbl> 0, -1, 0, 0, 10, 3, 20, -5, 10, 3…
## $ week_35                              <dbl> 5, -5, 3, -10, 3, -5, 0, 0, 0, 0,…
## $ week_36                              <dbl> 1, 5, 1, -20, 5, 20, -1, -3, 1, 3…
## $ week_37                              <dbl> 0, 0, 10, -1, 10, 3, 3, 0, 20, 1,…
## $ week_38                              <dbl> 10, -1, 0, -5, 5, 5, 20, -5, -3, …
## $ week_39                              <dbl> 3, 5, 1, 10, 20, 0, 5, 1, -5, 0, …
## $ week_40                              <dbl> 0, 0, 5, 1, 5, 1, 10, -5, -20, 3,…

# Changing some variables type to factors
hogwarts <- hogwarts |> mutate(
  across(c(house, course, sex, wandCore, bloodStatus), ~ as.factor(.x))
)
summary (hogwarts)

##        id               house     course      sex                    wandCore  
##  Min.   :  1.0   Gryffindor:126   1: 80   female:333   dragon heartstring:196  
##  1st Qu.:140.8   Hufflepuff:179   2:101   male  :227   phoenix feather   :181  
##  Median :280.5   Ravenclaw :122   3: 67                unicorn hair      :183  
##  Mean   :280.5   Slytherin :133   4: 71                                        
##  3rd Qu.:420.2                    5: 88                                        
##  Max.   :560.0                    6: 67                                        
##                                   7: 86                                        
##       bloodStatus      result        Defence against the dark arts exam
##  half-blood :391   Min.   :-292.00   Min.   : 0                        
##  muggle-born: 60   1st Qu.:   7.00   1st Qu.:39                        
##  pure-blood :109   Median :  70.50   Median :49                        
##                    Mean   :  59.71   Mean   :48                        
##                    3rd Qu.: 128.25   3rd Qu.:58                        
##                    Max.   : 260.00   Max.   :89                        
##                                                                        
##   Flying exam    Astronomy exam  Herbology exam  Divinations exam
##  Min.   : 0.00   Min.   : 0.00   Min.   : 0.00   Min.   : 0.00   
##  1st Qu.:36.00   1st Qu.:37.00   1st Qu.:39.00   1st Qu.:38.00   
##  Median :48.00   Median :49.00   Median :49.00   Median :49.00   
##  Mean   :47.37   Mean   :47.99   Mean   :47.75   Mean   :48.44   
##  3rd Qu.:60.00   3rd Qu.:60.00   3rd Qu.:58.00   3rd Qu.:59.00   
##  Max.   :85.00   Max.   :87.00   Max.   :86.00   Max.   :89.00   
##                                                                  
##   Charms exam    History of magic exam Arithmancy exam
##  Min.   : 0.00   Min.   : 0.00         Min.   : 0.00  
##  1st Qu.:39.00   1st Qu.:37.00         1st Qu.:38.00  
##  Median :49.00   Median :48.00         Median :50.00  
##  Mean   :48.36   Mean   :47.28         Mean   :48.38  
##  3rd Qu.:59.00   3rd Qu.:58.00         3rd Qu.:60.00  
##  Max.   :98.00   Max.   :85.00         Max.   :91.00  
##                                                       
##  Care of magical creatures exam Muggle studies exam Study of ancient runes exam
##  Min.   : 0.00                  Min.   : 0.00       Min.   : 0.00              
##  1st Qu.:38.00                  1st Qu.:38.00       1st Qu.:38.00              
##  Median :49.00                  Median :50.00       Median :48.00              
##  Mean   :48.11                  Mean   :48.64       Mean   :47.44              
##  3rd Qu.:60.00                  3rd Qu.:61.00       3rd Qu.:58.00              
##  Max.   :95.00                  Max.   :94.00       Max.   :89.00              
##                                                                                
##  Transfiguration exam  Potions exam        week_1            week_2       
##  Min.   :  0.00       Min.   :  0.00   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: 34.00       1st Qu.: 21.00   1st Qu.: -3.000   1st Qu.: -3.000  
##  Median : 49.00       Median : 47.00   Median :  1.000   Median :  1.000  
##  Mean   : 48.24       Mean   : 46.62   Mean   :  1.334   Mean   :  1.161  
##  3rd Qu.: 62.25       3rd Qu.: 68.00   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   :100.00       Max.   :100.00   Max.   : 50.000   Max.   : 20.000  
##                                                                           
##      week_3            week_4           week_5             week_6       
##  Min.   :-20.000   Min.   :-20.00   Min.   :-20.0000   Min.   :-20.000  
##  1st Qu.: -1.500   1st Qu.: -1.00   1st Qu.: -3.0000   1st Qu.: -1.000  
##  Median :  1.000   Median :  1.00   Median :  1.0000   Median :  1.000  
##  Mean   :  1.407   Mean   :  1.82   Mean   :  0.9196   Mean   :  1.448  
##  3rd Qu.:  5.000   3rd Qu.:  5.00   3rd Qu.:  5.0000   3rd Qu.:  5.000  
##  Max.   : 20.000   Max.   : 20.00   Max.   : 20.0000   Max.   : 20.000  
##                                                                         
##      week_7            week_8          week_9          week_10       
##  Min.   :-20.000   Min.   :-20.0   Min.   :-50.00   Min.   :-20.000  
##  1st Qu.: -3.000   1st Qu.: -1.0   1st Qu.: -1.00   1st Qu.: -1.000  
##  Median :  1.000   Median :  1.0   Median :  1.00   Median :  1.000  
##  Mean   :  1.529   Mean   :  1.6   Mean   :  1.63   Mean   :  1.457  
##  3rd Qu.:  5.000   3rd Qu.:  5.0   3rd Qu.:  5.00   3rd Qu.:  5.000  
##  Max.   : 20.000   Max.   : 20.0   Max.   : 20.00   Max.   : 20.000  
##                                                                      
##     week_11           week_12           week_13            week_14      
##  Min.   :-20.000   Min.   :-20.000   Min.   :-20.0000   Min.   :-20.00  
##  1st Qu.: -1.000   1st Qu.: -1.000   1st Qu.: -3.0000   1st Qu.: -1.00  
##  Median :  1.000   Median :  1.000   Median :  0.0000   Median :  1.00  
##  Mean   :  1.586   Mean   :  1.689   Mean   :  0.7393   Mean   :  1.53  
##  3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.0000   3rd Qu.:  5.00  
##  Max.   : 20.000   Max.   : 20.000   Max.   : 50.0000   Max.   : 20.00  
##                                                                         
##     week_15           week_16           week_17         week_18       
##  Min.   :-20.000   Min.   :-20.000   Min.   :-20.0   Min.   :-20.000  
##  1st Qu.: -1.000   1st Qu.: -1.000   1st Qu.: -1.0   1st Qu.: -1.000  
##  Median :  1.000   Median :  1.000   Median :  1.0   Median :  1.000  
##  Mean   :  1.738   Mean   :  1.636   Mean   :  1.8   Mean   :  1.712  
##  3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.0   3rd Qu.:  5.000  
##  Max.   : 20.000   Max.   : 20.000   Max.   : 50.0   Max.   : 20.000  
##                                                                       
##     week_19            week_20          week_21           week_22       
##  Min.   :-50.0000   Min.   :-20.00   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -3.0000   1st Qu.: -3.00   1st Qu.: -1.000   1st Qu.: -1.000  
##  Median :  0.0000   Median :  1.00   Median :  1.000   Median :  1.000  
##  Mean   :  0.8071   Mean   :  1.55   Mean   :  1.816   Mean   :  1.527  
##  3rd Qu.:  5.0000   3rd Qu.:  5.00   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.0000   Max.   : 50.00   Max.   : 20.000   Max.   : 20.000  
##                                                                         
##     week_23            week_24           week_25           week_26       
##  Min.   :-20.0000   Min.   :-20.000   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -3.0000   1st Qu.: -1.000   1st Qu.: -3.000   1st Qu.: -3.000  
##  Median :  0.0000   Median :  1.000   Median :  1.000   Median :  1.000  
##  Mean   :  0.8036   Mean   :  1.168   Mean   :  1.364   Mean   :  1.248  
##  3rd Qu.:  5.0000   3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.0000   Max.   : 20.000   Max.   : 20.000   Max.   : 20.000  
##                                                                          
##     week_27         week_28           week_29           week_30       
##  Min.   :-50.0   Min.   :-20.000   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -1.0   1st Qu.: -1.500   1st Qu.: -1.000   1st Qu.: -1.000  
##  Median :  1.0   Median :  1.000   Median :  0.000   Median :  1.000  
##  Mean   :  1.5   Mean   :  1.923   Mean   :  1.262   Mean   :  1.705  
##  3rd Qu.:  5.0   3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.0   Max.   : 20.000   Max.   : 20.000   Max.   : 20.000  
##                                                                       
##     week_31          week_32           week_33           week_34       
##  Min.   :-20.00   Min.   :-20.000   Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -1.00   1st Qu.: -1.000   1st Qu.: -1.000   1st Qu.: -1.000  
##  Median :  1.00   Median :  1.000   Median :  1.000   Median :  1.000  
##  Mean   :  1.68   Mean   :  2.013   Mean   :  1.539   Mean   :  1.593  
##  3rd Qu.:  5.00   3rd Qu.:  5.000   3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.00   Max.   : 20.000   Max.   : 20.000   Max.   : 20.000  
##                                                                        
##     week_35         week_36           week_37          week_38       
##  Min.   :-20.0   Min.   :-20.000   Min.   :-20.00   Min.   :-20.000  
##  1st Qu.: -1.0   1st Qu.: -1.000   1st Qu.: -1.00   1st Qu.: -1.000  
##  Median :  1.0   Median :  1.000   Median :  1.00   Median :  1.000  
##  Mean   :  1.7   Mean   :  2.079   Mean   :  1.32   Mean   :  1.864  
##  3rd Qu.:  5.0   3rd Qu.:  5.000   3rd Qu.:  5.00   3rd Qu.:  5.000  
##  Max.   : 20.0   Max.   : 20.000   Max.   : 20.00   Max.   : 20.000  
##                                                                      
##     week_39           week_40       
##  Min.   :-20.000   Min.   :-20.000  
##  1st Qu.: -1.000   1st Qu.: -3.000  
##  Median :  1.000   Median :  0.000  
##  Mean   :  1.438   Mean   :  1.079  
##  3rd Qu.:  5.000   3rd Qu.:  5.000  
##  Max.   : 20.000   Max.   : 20.000  
## 

NA checking

sum(is.na(hogwarts))

## [1] 0

Оформление theme_custom

theme_custom <- theme(
    panel.background = element_rect(fill = "white"),
    plot.title = element_text(size = 25, hjust = 0.5),
    plot.subtitle = element_text(size = 20, hjust = 0.5),
    strip.text = element_text(size = 18),
    axis.text = element_text(size = 18),
    axis.title = element_text(size = 20),
    legend.title = element_text(size = 20),
    legend.text = element_text(size = 18),
    legend.position = "right",
    plot.margin=unit(c(1, 0.5, 1, 0.5),"cm")
  )

 theme_custom_small <- theme_custom +
  theme(legend.position="top", 
        legend.title = element_text(size = 14),
    legend.text = element_text(size = 14))

Столбчатые диаграммы (bar plots)

1. Result vs Herbology exam

hogwarts |> 
  ggplot(aes (x = `result`, y =`Herbology exam` ))+
  geom_point (shape= 3, size= 3)+
  geom_smooth (method = "lm", se= FALSE, colour = "blue4")+
  theme_custom

Scatterplot показывает тенденцию, что с увеличением результата за год (баллов) у студента увеличивается и оценка за экзамен по травологии (положительная корреляция). Между этими количественными величинами можно продположить взаимосвязь.

2. Result vs 4 exams

hogwarts |> select( house, result, `Herbology exam`, `Muggle studies exam`, `Potions exam`,`Divinations exam`)|> 
  pivot_longer(!c(house, result))  |>
   ggplot(aes(x = `result`, y=`value`))+
   geom_point (aes (color= `house`))+
   geom_smooth(se = FALSE,
              method = "lm")+
  scale_color_manual(values = c("Gryffindor" = "#C50000", 
                           "Hufflepuff" = "#ECB939", 
                           "Ravenclaw" = "#41A6D9", 
                           "Slytherin" = "#1F5D25"))+
  
  facet_wrap(~`name`, ncol = 2)+
  theme(aspect.ratio = 1)+
  theme_custom

##### 3. Result vs 4 exams - modification

hogwarts |> select( house, result, `Herbology exam`, `Muggle studies exam`, `Potions exam`,`Divinations exam`)|> 
  pivot_longer(!c(house, result))  |>
   ggplot(aes(x = `result`, y=`value`))+
   geom_point (aes (fill = `house`), shape = 21 ,  size = 2, stroke =0.1)+
   geom_smooth(aes (color = (`name`== "Potions exam")), 
              se = FALSE,
              method = "lm", show.legend = F)+ 
  #scale_color_discrete (name = "exam", labels = c("TRUE"= "Potions exam", "FALSE" = "Other"))+
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                           "Hufflepuff" = "#ECB939", 
                           "Ravenclaw" = "#41A6D9", 
                           "Slytherin" = "#1F5D25"))+
  
  facet_wrap(~`name`, ncol = 2)+
  theme(aspect.ratio = 1) +
  theme_custom

Geom_col и вещи вокруг него

1. Bar-plot (1 sem and bloodStatus)

Постройте барплот (столбиковую диаграмму) распредления набранных баллов за первый семестр (с 1-й по 17-ю неделю включительно) у студентов разного происхождения. Если у вас возникают трудности, можете обратиться к шпаргалке по dplyr от posit. Выдвиньте гипотезу (или гипотезы), почему распределение получилось именно таким. (1 б.)

res_1 <- hogwarts  |> select (house, bloodStatus,21:37) |> mutate (res_1sem = rowSums(across(where(is.numeric))))  |> select (house, bloodStatus,last_col() ) |> group_by (bloodStatus)  |> summarise (res_1sem = sum(res_1sem), count = n())

  ggplot(res_1)+
  geom_col(aes(x= bloodStatus, y= res_1sem, fill=bloodStatus ))+
  
  xlab (label = "blood status")+
  ylab (label = "result for 1 semester")+ 
  scale_fill_brewer(palette = "BuPu")+
  theme_custom

Гипотеза 1- полукровки более упорны в учебе, так как не так уверены в себе, как чистокровные волшебники. В то время как результат маглорожденных ниже, так как им тяжелее дается учеба в силу трудностей адаптации и воспитания. Гипотеза 2- значительно более высокий балл полукровок объясняется тем, что их значительно больше, чем других групп студентов по происхождению.

2. Bar-plot (1 sem and bloodStatus) + labels

Модифицируйте предыдущий график – отсортируйте столбцы в порядке убывания суммы баллов. Добавьте на график текстовые метки, отражающие число студентов каждого происхождения. Попробуйте использовать для этой задачи не geom_text, а geom_label. Настройте внешний вид geom_label по своему усмотрению. Поправьте название оси. Проинтерпретируйте график. Соотносится ли интерпретация с вашей гипотезой из пункта 1? (1 б.)

ggplot(res_1, aes(x= fct_reorder (bloodStatus, res_1sem, .desc= T), y= res_1sem, fill=bloodStatus ))+
  geom_col()+
  xlab (label = "blood_status")+
  scale_fill_brewer(palette = "BuPu")+
  geom_label(
    label=res_1$count, 
    nudge_x = 0.1, nudge_y = 0.1, 
    check_overlap = T, size= 8, show_guide  = FALSE
  )+
  xlab (label = "blood status")+
  ylab (label = "result for 1 semester")+
  theme_custom

Интерпретация:по числу баллов за первый семестр полукровки значительно превосходят как маглорожденных, так и чистокровных, так как их значительно больше. Визуальна заметна тенденция: чем ниже кол-во студентов в группе - тем меньше результат за 1 семестр. Для корректного сравнения успеваемости групп студентов по происхождению нужно использовать, например, среднее значение полученных баллов в каждой группе (с указанием ошибки, либо ДИ).

3. Bar-plot (1 sem and bloodStatus+ sex) + right labels

res_2<- hogwarts  |> select (house, sex, bloodStatus,21:37) |> mutate (res_1sem = rowSums(across(where(is.numeric))))  |> select (sex, bloodStatus,last_col() ) |> group_by (bloodStatus, sex)  |> summarise (res_1sem = sum(res_1sem)) |>
  mutate (bloodStatusandsex= paste0 ( bloodStatus, " ", sex))

bloodStatus_gender_barplot<-ggplot(res_2,aes(y = fct_reorder(bloodStatusandsex, res_1sem, .desc = FALSE), 
               x = res_1sem,
               fill= bloodStatus) )+
  geom_col()+
  scale_x_continuous(breaks= seq (-1000,11000,1000))+
  labs(x ="Результат за 1 семестр", y = "Происхождение и пол", title = "Результат за 1 семестр", caption = "Для курса по биостатистике")+
  geom_text(aes(x = max(res_1sem) + 1400, label = res_1sem), size = 8,
              position = position_dodge(width = 1))+
  scale_fill_brewer(name= "Происхождение", labels = c("полукровки","маглорожденные", "чистокровные"), palette = "Accent")+
  theme_custom
bloodStatus_gender_barplot

ggsave ("bloodStatus_gender_barplot.png", bloodStatus_gender_barplot, width = 20, height = 16, units = "in", dpi = 300)

4. coord_flip()

Функция делает, в большинстве случаев,то же самое, что изменение положение координат при создании эстетики (aes) или опциональная настройка аргумента ориентации в слоях geom и stat.

В документаци сказано, что coord_flip() полезна для геомов и статистик которые не поддерживают настройки ориентации и конвертации отображения у, зависимого от x, в отображение х, зависимого от y.
Пользователи отмечают что, например geom_density_ridges, не поддерживает изменение ориентации, поэтому для него использование coord_flip() оправдано.

Среди минусов: при применении не сохраняет заданный порядок факторов. Также плохо работает с фасетированеим.

Разное

1. Potions and runes - 3 ways

potions_runes <-hogwarts |> select (house, bloodStatus, sex, `Potions exam`, `Study of ancient runes exam`)
potions_runes_l <-hogwarts |> select (house, bloodStatus, sex, `Potions exam`, `Study of ancient runes exam`) |>
  pivot_longer(cols = c(`Potions exam`, `Study of ancient runes exam`), names_to = "class", values_to = "score")

potions_runes_sum <-potions_runes_l |> group_by(bloodStatus, class) |>  summarise (mean = mean(score)|>round(2) ,
                                                                                   CI_L = (mean(score, na.rm = TRUE) - (1.96 * sd(score, na.rm = TRUE)/sqrt (length(hogwarts))) |> round(2)),
                                                                                   CI_U = (mean(score, na.rm = TRUE) + (1.96 * sd(score, na.rm = TRUE)/sqrt (length(hogwarts))) |> round(2)))


  
sctr <- ggplot(potions_runes, aes(x = `Potions exam`,
                  y = `Study of ancient runes exam`, colour = house))+
  geom_point(alpha = 0.7, size =2)+
  geom_smooth( method = "lm", se= F)+
  scale_color_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25") )+
  theme_custom_small+
 theme (legend.position = "right")

bxpl <- ggplot(potions_runes_l, aes(x = `class`,
                  y = `score`, colour = house))+
  geom_boxplot(lwd= 1.5, width= 0.4, position=position_dodge(0.7), fill = "gray90")+
  scale_color_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25"))+
  theme_custom_small 

ptrng <- ggplot(potions_runes_sum)+
  geom_pointrange(aes(x=class,
                       y= mean, ymin = CI_L, ymax = CI_U, group=bloodStatus ,color = bloodStatus),
                   linewidth = 2,
                   size = 1.3, position=position_dodge(width = .5) )+
  scale_color_manual(values = c("half-blood" = "coral", 
                             "muggle-born" = "bisque2", 
                             "pure-blood" = "deeppink4"))+
  ylim (25,65)+
  theme_custom_small

ggarrange(        
  ggarrange(bxpl,ptrng , ncol = 2, labels = c("A", "B")), 
  ggarrange(sctr, labels = "C"),
  nrow = 2 )

1. Potions and runes - 3 ways

Визуализируйте средний балл по зельеварению студентов с различным происхождением. Вы вольны добавить дополнительные детали и информацию на график. Проинтерпретируйте результат. Как вы думаете, почему он именно такой? Если у вас есть гипотеза, проиллюстрируйте ее еще одним графиком (или графиками). Объедините их при помощи ggarrange. (по 1 б. за первый и график и правильную интерпретацию с подтверждением в виде второго графика и текстовой аргументации). Измените порядок ваших фигур на первом графике слева направо следующим образом: маглорожденные,, чистокровные, полукровки.

Скорректируйте название оси. Если у вас возникают сложности, обратитесь к шпаргалке по пакету forcats от posit. (Дополнительные 0.5 б.)

Средний балл по зелье студентов с разл происх

blstat<- hogwarts |> select (bloodStatus, `Potions exam`)|> group_by(bloodStatus) |>  summarise (mean = (mean(`Potions exam`)|>round(2)), 
                                                                                        sd = (sd(`Potions exam`) |> round(2))) |>
                                                                             mutate(bloodStatus= fct_relevel(bloodStatus, 
                                                                                                             "muggle-born", "pure-blood", "half-blood")) 
  
  bldst_means<- ggplot(blstat, aes(x=bloodStatus,
                       y= mean))+
   geom_pointrange(aes(ymin = mean+sd,
                       ymax= mean-sd, 
                       color=bloodStatus ),
                    linewidth = 2,
                    size= 1.5,
                   fatten = 4)+
  scale_color_manual(values = c("half-blood" = "coral", 
                             "muggle-born" = "bisque2", 
                             "pure-blood" = "deeppink4"))+
  labs(x ="blood status", y = "score", title = "Potions exam result (Mean \u00B1 SD)")+
  geom_label(
    label=  paste0 (blstat$mean,"\u00B1",blstat$sd), 
    nudge_x = 0.2, nudge_y =20, 
    check_overlap = T, size= 6, show_guide  = FALSE
)+
  geom_hline(linetype = "dotted", yintercept = 50, size = 1, color = "gray60")+
  ylim (0,100)+
  theme_custom +
  theme (legend.position = "top")
     
  
  bldst_means

Наибольший средний балл за экзамен по зельеварению наблюдается у чистокловных студентов, наименьший- у маглорожденных студентов. При этом результат скорее всего не является статистически значимым.Однако можно выдвинуть две гипотезы: либо преподаватель предвзят и реальные успехи маглорожденных студентов не отличаются от студентов другого происхождения, либо маглорожденные студенты имеют в целом худшую успеваемость (альтернативная гипотеза). Это можно проверить, сравнив успеваемость студентов а) по среднему колличеству баллов, которые они приносят факультету, б) по средним результатам нескольким другим дисциплинам (найти условно более сложные экзамены по анализу summary не удалось).

 bldst_resm <- hogwarts |> select (bloodStatus, result)|> group_by(bloodStatus) |> summarise (mean = (mean(result)|>round(2)),
                                                                               sd = (sd(result) |> round(2)))|>
                                                                             mutate(bloodStatus= fct_relevel(bloodStatus, 
                                                                                                             "muggle-born", "pure-blood", "half-blood")) |>
  ggplot ()+
   geom_pointrange(aes(x=bloodStatus, y= mean, ymin = mean+sd,
                       ymax= mean-sd, 
                       color=bloodStatus),
                    linewidth = 2,
                    size= 1.5,
                   fatten = 4)+
  scale_color_manual(values = c("half-blood" = "coral", 
                             "muggle-born" = "bisque2", 
                             "pure-blood" = "deeppink4"))+
  labs(x ="blood status", y = "result (Mean \u00B1 SD)", title = "Year result (Mean \u00B1 SD)", color = "Blood status") +
  geom_hline(linetype = "dotted", yintercept = 50, size = 1, color = "gray60") +
  theme_custom+
  theme(legend.key = element_rect(color = "black"),
        legend.key.spacing.y = unit(1, "cm"))

bldst_5_ex <- hogwarts |> select (bloodStatus, `Charms exam`,`Defence against the dark arts exam`, 
                                  `Study of ancient runes exam`, `Transfiguration exam`, `Arithmancy exam`)|>
                         group_by(bloodStatus) |> rowwise () |>
                         mutate (res_5_exams = mean(c_across(where(is.numeric))))  |> 
                          select (bloodStatus,last_col()) |>
                          mutate(bloodStatus= fct_relevel(bloodStatus,"muggle-born", "pure-blood", "half-blood")) |>
  ggplot (aes (x= bloodStatus, y = res_5_exams, fill = bloodStatus))+
  geom_boxplot()+
  stat_summary(fun.y=mean, geom="point", shape=20, size=14, color="red", fill="red")+
  scale_fill_manual(values = c("half-blood" = "coral", 
                             "muggle-born" = "bisque2", 
                             "pure-blood" = "deeppink4"))+
  labs(x ="blood status", y = " aver. score for 5 exams", title = "Average result for 5 exams")+
  theme_custom

ggarrange( bldst_means + theme (legend.position = "none" ), 
           bldst_resm + theme (legend.position = c(0.5, -0.7)), 
           bldst_5_ex + theme (legend.position = "none"))

Воспроизведение графика

#library(extrafont)
#font_import() 
loadfonts(quiet = T)
#fonts()

theme_custom_spec <- theme(
    panel.background =  element_rect(fill = "white", colour = NA), 
    panel.grid.major =  element_line(colour = NA, size = 0.2),
    panel.grid.minor =  element_line(colour = NA, size = 0.5),
    panel.margin =      unit(0.25, "lines"),
    axis.ticks  = element_line(linewidth = 1, color = "grey50"),
    axis.ticks.length.y =  unit(.1, "cm"),
    text = element_text(family = "serif"),
    
    legend.text =       element_text(size= 22, face ="italic"),
    legend.title =      element_text(size= 22, hjust = 0),
    legend.position =   c(0.5, 0.1),
    
    
    axis.text.x = element_text(colour = NA, lineheight = 0.9, vjust = 1),
    axis.text.y = element_text(lineheight = 0.9, size= 20, hjust = 1),
    axis.title.y =element_text( size = 24, vjust = 0.5),
    axis.title.x =element_text(color= NA, size = 20, vjust = 0.5),
    plot.title = element_text(size = 28, hjust = 0.5),
    plot.subtitle = element_text(color= "darkgoldenrod4", size = 18, hjust = 0.5, family = "sans" ),
    plot.caption = element_text(size = 11, margin=margin(t = -25, unit = "pt"), family = "Arial Narrow" ),
    strip.background =  element_rect(fill = "grey80", colour = "NA"), 
    strip.text.x =      element_text(size = 22)
  )
sex_rus <- as_labeller(c(
                    `male` = "Мальчики",
                    `female` = "Девочки"
                    ))

hogwarts|> select(house, result, sex) |> group_by (house)|> mutate (housesums = mean (result)) |> 
  ggplot ()+
  geom_violin(aes(y = `result`, x= `house`, fill = `house`), colour = "grey49", 
                 bins = 40) +
  geom_boxplot(aes(y = `result`, x= `house`), width=0.04, fill = "white", color = "gray60", outlier.colour = "gray60")+
  stat_summary(aes(y = `housesums`, x= `house`), fun.y = mean, mult=1, 
               geom="point", shape = 23, size = 9, fill = "brown", stroke = 1.5, show.legend = F)+
  geom_hline(linetype ='dashed', yintercept = 0,size = 1.5, color = "coral")+
  scale_fill_manual(values = c("Gryffindor" = "#C50000", 
                             "Hufflepuff" = "#ECB939", 
                             "Ravenclaw" = "#41A6D9", 
                             "Slytherin" = "#1F5D25"),
                    labels = c ("Gryffindor" = "Гриффиндор", 
                             "Hufflepuff" = "Пуффендуй", 
                             "Ravenclaw" = "Когтевран", 
                             "Slytherin" = "Слизерин")) +
  scale_y_continuous(breaks= seq (-300,300,50))+
  labs(y = "Количество очков", title = "Баллы студентов Хогвартса",
       subtitle = "Распределение числа баллов у студентов различных факультетов Хогвартса в 2023-2024 учебном году",
       caption = "Источник: нездоровая фантазия автора лекции", fill = "Факультет") +
   facet_grid(~`sex`, labeller = sex_rus)+
  theme_custom_spec

#hogwarts |> group_by(sex, house, course) |> summarize(across(.cols = where(is.numeric),.fns = mean))

Интерпретация: График violin-plot отражает распределение (плотности верояности) результата студентов,т.е. накопленных баллов за год, в зависимости от факультета с фасетированием по полу. Ромбики показывают среднюю сумму баллов по всем студентам факультета без разбиения (фасетирования) по полу, т.е. одинаковы для мальчиков и девочек. Линия по оси Y резделяет график на область положительных и отрицательных значений баллов.

Согласно графику наибольшая успеваемость у М и Д Когтеврана. Также разброс результата (по длине violin) наименьший для Д и М Когтеврана. По плотностям распределения и боксплотам можно заключить, что Девочки Когтевна и Слизерина приносят больше баллов в течение года своему факультету, чем Мальчики, в то время как на Гриффиндрое мальчики, напротив, скорее более успешны. Наиболее значимо различие между полами в случае Слизерина - Девочки почти так же успешны как ученицы Когтеврана, а мальчики, напротив, лишь отнимают очки (медиана порядка -150). Такое различие между Мальчиками и Девочками приводит к тому, что средний балл всех студентов Слизерина ниже, чем у всех других факультетов.